home *** CD-ROM | disk | FTP | other *** search
/ Aminet 35 / Aminet 35 (2000)(Schatztruhe)[!][Feb 2000].iso / Aminet / dev / basic / BB2_DTPics.lha / DT_Pic-Funcs < prev   
Encoding:
Text File  |  1999-10-28  |  11.5 KB  |  417 lines
  1. ; DTLoad - functions v1.25
  2. ; By Leigh Parry
  3. ;
  4. ; Requires :
  5. ;    amigalibs.res in compiler options
  6. ;    installed datatypes for pictures (JPEG for example pics)
  7. ;
  8. ; Seperate file for INCBIN'ing - DTPic-Funcs.asc
  9. ;
  10. ; **** Important ****
  11. ; ALTERED NEWTYPE - now stores a mapped variable
  12. ;
  13. ; Took NBitmaps out of DT_2_BM
  14. ; Also by default Function is commented out.
  15. ; if you want to use it just un-comment it.
  16.  
  17.  
  18. DEFTYPE .l
  19.  
  20. ._SETUP_VARS
  21. #DTM_FrameBox  =$601
  22. #OBP_Precision =$84000000
  23.  
  24. #DTP_IFF=#DTWM_IFF
  25. #DTP_RAW=#DTWM_RAW
  26. #DTPObjects=10
  27.  
  28. NEWTYPE .DTPInfo                         ; a newtype to store our DT's info
  29.   *obj.b
  30.   *bm.BitMap
  31.   bmw.l
  32.   bmh.l
  33.   bmd.l
  34.   ModeID.l
  35.   mapped.b
  36. End NEWTYPE
  37.  
  38. Dim DTPictures.DTPInfo(#DTPObjects)                    ; an array to store several objects
  39.  
  40. ; ----------------------------------------------------------
  41.  
  42. ._ReleaseDT
  43. Statement ReleaseDT {OBJ}
  44. ; OBJ = number of the object we want to free
  45. ; if it is still displayed then any colours which change
  46. ; make the pic look terrible.
  47.  
  48.   SHARED DTPictures()
  49.   If DTPictures(OBJ)\obj
  50.     DisposeDTObject_ DTPictures(OBJ)\obj
  51.     DTPictures(OBJ)\obj=0
  52.   End If
  53. End Statement
  54.  
  55. ; ----------------------------------------------------------
  56.  
  57. ._ReleaseAllDT
  58. Statement ReleaseALLDT {}
  59. ; Free all the objects
  60.   For n=0 To #DTPObjects
  61.     ReleaseDT{n}
  62.   Next n
  63. End Statement
  64.  
  65. ; ----------------------------------------------------------
  66.  
  67. ._DTLoad
  68. Function DTLoad {OBJ.l,Fyle.s,RMap.b,Prec} ; ,Palet}
  69. ; OBJ   = number to use - must be in limit of DTPictures() array
  70. ; RMap  = Remap the image to used screen 0=NO , anything_else=YES
  71. ; Prec  = Precision of the remap  -1=Exact(Best) 0=Image(Good) 16=Icon(Poor) 32=GUI(Poor)
  72. ; Palet = Palette object to store changed colour values in. -1=No Palet
  73.  
  74.   SHARED DTPictures()
  75.  
  76.   If DTPictures(OBJ)\obj Then ReleaseDT {OBJ}
  77.  
  78.   DEFTYPE.BitMapHeader   *bmhd
  79.   DEFTYPE.l              *cregs,ModeID
  80.   DEFTYPE.dtFrameBox     dtf
  81.   DEFTYPE.FrameInfo      fri
  82.   DEFTYPE.gpLayout       gpl
  83.   DEFTYPE.BitMap         *bm,*dsbm,*clbm
  84.   DEFTYPE.l
  85.  
  86.   *scr.Screen     = Peek.l(Addr Screen(Used Screen))
  87.  
  88. ;  disdep          = *scr\BitMap\Depth
  89. ;  numcols         = 2^disdep-1
  90.   Dim attrs.TagItem (5)
  91.   attrs(0)\ti_Tag = #DTA_SourceType,#DTST_FILE
  92.   attrs(1)\ti_Tag = #DTA_GroupID,#GID_PICTURE
  93.  
  94.   If RMap=0
  95.     attrs(2)\ti_Tag = #PDTA_Remap,0
  96.     attrs(3)\ti_Tag = #TAG_DONE,0
  97.   Else
  98.     attrs(2)\ti_Tag = #PDTA_Remap,-1
  99.     attrs(3)\ti_Tag = #PDTA_Screen,*scr
  100.     attrs(4)\ti_Tag = #OBP_Precision,Prec
  101.     attrs(5)\ti_Tag = #TAG_DONE,0
  102.   End If
  103.  
  104.   name$=Fyle.s : rmap=RMap
  105.   success=0
  106.  
  107.   *obj.b=NewDTObjectA_(&name$,attrs(0))
  108.   If *obj
  109.     dtf\MethodID=#DTM_FrameBox
  110.     dtf\dtf_ContentsInfo=&fri,&fri,SizeOf.FrameInfo
  111.     DoDTMethodA_ *obj,0,0,&dtf
  112.     gpl\MethodID=#DTM_PROCLAYOUT
  113.     gpl\gpl_GInfo=0
  114.     gpl\gpl_Initial=1
  115.     DoDTMethodA_ *obj,0,0,&gpl
  116.  
  117.     GetAttr_ #PDTA_ModeID,*obj,&ModeID
  118.     GetAttr_ #PDTA_BitMapHeader,*obj,&*bmhd
  119.     GetAttr_ #PDTA_BitMap,*obj,&*bm
  120.  
  121.     bmw.l=*bmhd\bmh_Width
  122.     bmh.l=*bmhd\bmh_Height
  123.     bmd.l=*bmhd\bmh_Depth
  124.  
  125.     success=1
  126.  
  127.   End If
  128.  
  129.   If success=0
  130.     DisposeDTObject_ *obj
  131.     DTPictures(OBJ)\obj=0
  132.   Else
  133.     DTPictures(OBJ)\obj=*obj,*bm,bmw,bmh,bmd,ModeID,rmap
  134.   End If
  135.   Function Return success
  136. End Function
  137.  
  138. ; ----------------------------------------------------------
  139.  
  140. ._BM_2_BM
  141. Function BM_2_BM {*SrcB,SrcW,SrcH,*DestB,DestW,DestH}
  142. ; copy one BitMap into another,
  143. ; with scaling if different sizes
  144.  
  145. ; Used by DT_2_BM and when copying into a created System BitMap
  146. ; So if you're using the DT_2_BM function you still need this one.
  147.  
  148.   success=0
  149.   If *SrcB
  150.     BSA.BitScaleArgs\bsa_SrcX=0
  151.     BSA\bsa_SrcY=0
  152.     BSA\bsa_SrcWidth=SrcW
  153.     BSA\bsa_SrcHeight=SrcH
  154.     BSA\bsa_XSrcFactor=SrcW
  155.     BSA\bsa_YSrcFactor=SrcH
  156.     BSA\bsa_DestX=0
  157.     BSA\bsa_DestY=0
  158.     BSA\bsa_DestWidth=DestW
  159.     BSA\bsa_DestHeight=DestH
  160.     BSA\bsa_XDestFactor=DestW
  161.     BSA\bsa_YDestFactor=DestH
  162.     BSA\bsa_SrcBitMap=*SrcB
  163.     BSA\bsa_DestBitMap=*DestB
  164.     BitMapScale_ &BSA
  165.     success=1
  166.   End If
  167.   Function Return success
  168. End Function
  169.  
  170. ; ----------------------------------------------------------
  171.  
  172. ._Save_IFF
  173. Function.l Save_IFF {Fyle.s,*BM.BitMap,Palet,bwid,valu,DTPal}
  174. ; Fyle.s      = Filename to save to
  175. ; BM          = Pointer to the BitMap
  176. ;               (If using Blitz BitMap use  Addr BitMap(#))
  177. ; Palet       = Palette to save to the file
  178. ; bwid        = REAL Width (To be stored in Header)
  179. ; valu        = ModeID to save in file  0=No Id
  180. ; DTPal       = Use DTPictures(DTPal) palette.
  181.  
  182.   SHARED DTPictures()
  183.  
  184.   NEWTYPE .rgbcomp      :_red.l:_green.l:_blue.l: End NEWTYPE
  185.   NEWTYPE .palettedata  :_numcols.w:_zero.w:_rgbs.rgbcomp[256]:_zero2.l: End NEWTYPE
  186.   NEWTYPE .palette      :*_dat.palettedata:_numcols.w:_lowcol.w:_hicol.w:_speed.w:_var.w:_pad.b[114]: End NEWTYPE
  187.  
  188.   DEFTYPE .BitMapHeader  *bmhd,*dtdm
  189.   DEFTYPE .BitMap        *dbm
  190.   DEFTYPE .l             *cregs
  191.   DEFTYPE .l
  192.  
  193.   name$=Fyle.s
  194.   modeid.l=valu
  195.  
  196.   *dbm=*BM
  197.   bmwid=*dbm\BytesPerRow
  198.   bmhit=*dbm\Rows
  199.   bmflg=*dbm\Flags
  200.   bmdep=*dbm\Depth
  201.   leaved=0
  202.  
  203.   If bmwid*8=>bwid
  204.     If bmwid*8>bwid+8 Then bmwid=(bwid+8)/8+1
  205.  
  206. ; findout if were using a DT bitmap and if Interleaved
  207.     If DTPal>-1 AND DTPal<#DTPObjects+1
  208.       *dtbm=DTPictures(DTPal)\bm
  209.       GetAttr_ #PDTA_CRegs,DTPictures(DTPal)\obj,&*cregs
  210.       If bmdep>1 AND *dbm=*dtbm
  211. ;        If *dbm\Planes[1]=*dbm\Planes[0]+bmwid Then leaved=1
  212.         If *dbm\BytesPerRow=((bwid+8)/8+1)*bmdep Then leaved=1
  213.       End If
  214.     End If
  215.  
  216.     bitmapsize=bmwid*bmhit*bmdep
  217.     *bmhd\bmh_Width=bwid
  218.     *bmhd\bmh_Height=bmhit
  219.     *bmhd\bmh_Depth=bmdep
  220.     *bmhd\bmh_Compression=0
  221.     *bmhd\bmh_PageWidth=bwid
  222.     *bmhd\bmh_PageHeight=bmhit
  223.  
  224. ; Thanks to Sami Naatanen <sami.naatanen@dlc.fi> (For correct spelling of Naatanen see readme file)
  225. ; for pointing out to use Cvl
  226.  
  227.     ID_ILBM=Cvl("ILBM") : ID_BMHD=Cvl("BMHD")
  228.     ID_CMAP=Cvl("CMAP") : ID_CAMG=Cvl("CAMG")
  229.  
  230.     OK=0
  231.     *iff.IFFHandle=AllocIFF_()
  232.     If *iff
  233.       lock.l=Open_(&name$,#MODE_NEWFILE)
  234.       If lock
  235.         *iff\iff_Stream=lock
  236.         InitIFFasDOS_(*iff)
  237.         ifferr.l=OpenIFF_(*iff,#IFFF_WRITE)
  238.         If ifferr=0
  239.           ifferr=PushChunk_(*iff,ID_ILBM,#ID_FORM,#IFFSIZE_UNKNOWN)
  240.           If ifferr=0
  241.             ifferr=PushChunk_(*iff,0,ID_BMHD,SizeOf.BitMapHeader)
  242.             If ifferr=0
  243.               ifferr=WriteChunkRecords_(*iff,*bmhd,SizeOf.BitMapHeader,1)
  244.               If ifferr=1
  245.                 PopChunk_(*iff)
  246.               End If
  247.             End If
  248.             ifferr=PushChunk_(*iff,0,ID_CMAP,#IFFSIZE_UNKNOWN)
  249.             If ifferr=0
  250.               If DTPal<0
  251.                 *pal.palette=Addr Palette(Palet)
  252.                 penn=*pal\_numcols
  253.               Else
  254.                 penn=2^bmdep
  255.               End If
  256.               paletsize=(penn)*3
  257.               *padr=AllocVec_ (paletsize,0) ; change to ?
  258.               If *padr
  259.                 For t = 0 To penn-1
  260.                   If DTPal<0
  261.                     cr.l=*pal\_dat\_rgbs[t]\_red MOD 256
  262.                     cg.l=*pal\_dat\_rgbs[t]\_green MOD 256
  263.                     cb.l=*pal\_dat\_rgbs[t]\_blue MOD 256
  264.                   Else
  265.                     j.l=t*12
  266.                     j+*cregs
  267.                     cr.l=Peek.b(j  ) MOD 256
  268.                     cg.l=Peek.b(j+4) MOD 256
  269.                     cb.l=Peek.b(j+8) MOD 256
  270.                   End If
  271.                   k.l=*padr+(t*3)
  272.                   Poke.b k,cr : Poke.b k+1,cg : Poke.b k+2,cb
  273.                 Next t
  274.                 ifferr=WriteChunkBytes_(*iff,*padr,paletsize)
  275.                 If ifferr=paletsize
  276.                   PopChunk_(*iff)
  277.                 End If
  278.                 FreeVec_ *padr
  279.               End If
  280.             End If
  281.             If modeid
  282.               ifferr=PushChunk_(*iff,0,ID_CAMG,4)
  283.               If ifferr=0
  284.                 ifferr=WriteChunkBytes_(*iff,&modeid,4)
  285.                 If ifferr=4
  286.                   PopChunk_(*iff)
  287.                 End If
  288.               End If
  289.             End If
  290.             ifferr=PushChunk_(*iff,0,#ID_BODY,#IFFSIZE_UNKNOWN)
  291.             If ifferr=0
  292.               *badr=AllocVec_ (bitmapsize,0)
  293.               If *badr
  294.                 iloffset=0 : bmoffset=0
  295.                 If leaved=1
  296.                   bmoffset=*dbm\Planes[0]
  297.                   For n=0 To bmhit*bmwid*bmdep-1
  298.                     Poke.b *badr+n,Peek.b(bmoffset+n)
  299.                   Next n
  300.                 Else
  301.                   For y=0 To bmhit-1
  302.                     For dep=0 To bmdep-1
  303.                       For x=0 To bmwid-1
  304.                         iloffset+1
  305.                         Poke.b *badr+iloffset-1,Peek.b(*dbm\Planes[dep]+bmoffset+x)
  306.                       Next x
  307.                     Next dep
  308.                     bmoffset+bmwid
  309.                   Next y
  310.                 End If
  311.                 ifferr=WriteChunkBytes_(*iff,*badr,bitmapsize)
  312.                 If ifferr=bitmapsize
  313.                   PopChunk_(*iff)
  314.                   OK+1
  315.                 End If
  316.                 FreeVec_ *badr
  317.               End If
  318.             End If
  319.             PopChunk_(*iff)
  320.           End If
  321.           CloseIFF_(*iff)
  322.         End If
  323.         Close_(lock)
  324.       End If
  325.       If OK=0 Then DeleteFile_(&name)
  326.       FreeIFF_(*iff)
  327.     End If
  328.   End If
  329.   Function Return OK
  330. End Function
  331.  
  332. ; ----------------------------------------------------------
  333.  
  334. ._DTSave
  335. Function.l DTSave {Fyle.s,OBJ}
  336. ; Save the 'OBJ'ect to 'file'
  337.  
  338. ; If a picture is'nt remapped to a screen then for some reason
  339. ; DTSave doesn't output a legal File. (Missing the palette info.)
  340. ; This is a problem with datatypes, not this function
  341. ; Also can produce overruns on width.
  342.  
  343. ; Because the only picture datatype that is able to save
  344. ; is the RGFX one, I'm just sending all objects to Save_IFF{}
  345. ; when more datatypes support the DTM_WRITE method I'll redo
  346. ; the code to allow exporting.
  347.  
  348.   SHARED DTPictures()
  349.   If DTPictures(OBJ)\obj
  350.     name$=Fyle.s
  351. ; Get details and send over to Save_IFF{}
  352.     *bbm.BitMap=DTPictures(OBJ)\bm
  353.     bwid=DTPictures(OBJ)\bmw
  354.     bmid=DTPictures(OBJ)\ModeID
  355.     bhit=DTPictures(OBJ)\bmh
  356.     bdep=DTPictures(OBJ)\bmd
  357.     *scr.Screen     = Peek.l(Addr Screen(0))
  358.     disdep          = *scr\BitMap\Depth
  359.     If DTPictures(OBJ)\mapped=1 Then bdep=disdep : OBJ=-1
  360.     *bm2.BitMap=AllocBitMap_(bwid,bhit,bdep,#BMF_CLEAR,0)
  361.     If *bm2
  362.       suc=BM_2_BM {*bbm,bwid,bhit,*bm2,bwid,bhit}
  363.       If suc
  364.         OK=Save_IFF{name$,*bm2,1,bwid,bmid,OBJ}
  365.       End If
  366.       FreeBitMap_ *bm2
  367.     End If
  368. ;    DEFTYPE .dtWrite  dtw
  369. ;    fh.l=Open_(&name$,#MODE_NEWFILE)
  370. ;    If fh
  371. ;      dtw\MethodID=#DTM_WRITE
  372. ;      dtw\dtw_FileHandle=fh
  373. ;      dtw\dtw_Mode=FRMT
  374. ;      OK=DoDTMethodA_ (DTPictures(OBJ)\obj,-1,-1,&dtw)
  375. ;      Close_ fh
  376. ;      If OK=0 Then DeleteFile_(&name$)
  377. ;    End If
  378.   End If
  379.   Function Return OK
  380. End Function
  381.  
  382. .
  383. ; ----------------------------------------------------------
  384.  
  385. ._DT_2_BM ; (Blitz BitMap)
  386. ;Function DT_2_BM {OBJ,bmap,nbmw,nbmh}
  387. ;; OBJ = number of the object
  388. ;; bmap is the number of BitMap to create
  389. ;; nbmw & nbmh are new width and height of bitmap
  390. ;; leave 0 to keep original sizes - just copy into (N)BitMap
  391.  
  392. ;  SHARED DTPictures()
  393. ;  *scr.Screen     = Peek.l(Addr Screen(Used Screen))
  394. ;  disdep          = *scr\BitMap\Depth
  395. ;  If DTPictures(OBJ)\obj
  396. ;    success=0
  397. ;    bmw=DTPictures(OBJ)\bmw
  398. ;    bmh=DTPictures(OBJ)\bmh
  399. ;    bmd=DTPictures(OBJ)\bmd
  400. ;    If nbmw=0 OR nbmh=0
  401. ;      nbmw=bmw : nbmh=bmh
  402. ;    End If
  403. ;    *bm1=Addr BitMap(bmap)
  404. ;    If *bm1
  405. ;      Free BitMap bmap
  406. ;    EndIf
  407. ;    BitMap bmap,nbmw,nbmh,disdep
  408. ;    *bm1=Addr BitMap(bmap)
  409. ;    If *bm1
  410. ;      success=BM_2_BM {DTPictures(OBJ)\bm,bmw,bmh,*bm1,nbmw,nbmh}
  411. ;    EndIf
  412. ;  End If
  413. ;  Function Return success
  414. ;End Function
  415.  
  416. ; ------------------------------------------------------------
  417.